package calculate_ortholog_type_in_ortholog_sets;

require Exporter;


our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(calculate_ortholog_type_in_ortholog_sets);



use strict;
use warnings;
use DBI;
use DBD::Pg;
use Carp;
use FindBin;
#_________________________________________________________________________________________

#	get_ortholog_counts_per_clade_per_species

#		for each clade and each species within the clade
#		get the number of either genes        (if $initial = 1)
#						  or     orthologs    (if $initial = 0)
#_________________________________________________________________________________________
sub get_ortholog_counts_per_clade_per_species($$$)
{
	my ($dbh, $protocol_id, $initial) = @_;


	#
	#	list of ortholog counts per species
	#
	print STDERR "\tCreate list of ortholog counts per ortholog_set per species\n";
	if (!$initial)
	{
		$initial = "ortholog_type ~ 'to' AND" ;
	}
	else
	{
		$initial = '';
	}
	my $sql_cmd = <<"PL/SQLCMD";
		-- CREATE TABLE of ortholog counts per ortholog_set per species
		SELECT 
				species, 
				ortholog_id, 
				COUNT(*)
			INTO 
				TEMP t_ortholog_counts_per_clade_per_species 
			FROM 
				ortholog_sets 
			WHERE 
				$initial
				protocol_id = $protocol_id
			GROUP BY 
				ortholog_id, 
				species;
PL/SQLCMD
	$dbh->do( $sql_cmd) or confess $dbh->errstr.".";
}

#-----------------------------------------------------------------------------------------
#
#	get_ortholog_counts_per_clade
#		join the gene/ortholog_counts for both species in each ortholog clade
#
#-----------------------------------------------------------------------------------------
sub get_ortholog_counts_per_clade($)
{
	my ($dbh) = @_;
	print STDERR "\tCreate list of ortholog counts per clade, including Orphaned by pseudos\n";
	my $sql_cmd = <<"PL/SQLCMD";
		-- Create list of ortholog counts per ortholog_set per species pair, including Orphaned by pseudos
    	SELECT 
    			ortholog_id, 
    			a.COUNT AS count1, 
    			b.COUNT AS count2, 
    			a.species AS species1, 
    			b.species AS species2
    		INTO 
    			TEMP t_ortholog_type_per_clade
    		FROM 
    			t_ortholog_counts_per_clade_per_species a FULL JOIN 
    			t_ortholog_counts_per_clade_per_species b USING (ortholog_id) 
    		WHERE 
    			a.species < b.species;
PL/SQLCMD
	$dbh->do( $sql_cmd) or confess $dbh->errstr.".";

}


#-----------------------------------------------------------------------------------------
#
#	set_ortholog_types_per_clade_by_counts
#	
#		set the ortholog_type for each clade depending on the gene/ortholog counts	
#
#-----------------------------------------------------------------------------------------
sub set_ortholog_types_per_clade_by_counts($)
{
	my ($dbh) = @_;
	print STDERR "\tSet ortholog_type per clade by gene counts (1:1 etc.)\n";
	my $sql_cmd = <<"PL/SQLCMD";
		-- Set ortholog_type (1:1 etc.)
		ALTER TABLE t_ortholog_type_per_clade ADD COLUMN ortholog_type TEXT;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = '1 to m' 
															WHERE count1 = 1 AND count2 > 1;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = 'm to 1' 
															WHERE count1 > 1 AND count2 = 1;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = 'm to m' 
															WHERE count1 > 1 AND count2 > 1;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = '1 to 1' 
															WHERE count1 = 1 AND count2 = 1;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = 'Orphan by pseudo' 
															WHERE (count1 = 0 OR count2 = 0) AND count1 <> count2;
		UPDATE t_ortholog_type_per_clade SET ortholog_type = 'Orphan by pseudo' 
															WHERE count1 IS NULL or count2 IS NULL;
PL/SQLCMD
	$dbh->do( $sql_cmd) or confess $dbh->errstr.".";
}

sub update_ortholog_types($$)
{
	my ($dbh, $protocol_id) = @_;

	
    print STDERR "\tUpdate ortholog types except for pseudos and Orphan paralogs\n";
    my $sql_cmd = <<"PL/SQLCMD";
	CREATE INDEX i__ortholog_type_per_clade on t_ortholog_type_per_clade (ortholog_id);
	CREATE INDEX i__t_ortholog_sets ON 
            orthologs.ortholog_sets (ortholog_id) 
		WHERE 
            ((ortholog_type <> 'pseudo' AND 
            ortholog_type <> 'Orphan paralog') or
            ortholog_type IS NULL) AND
            protocol_id = $protocol_id;
    
    -- Update ortholog sets
    UPDATE 
            orthologs.ortholog_sets 
        SET 
            ortholog_type = t_ortholog_type_per_clade.ortholog_type 
        FROM 
            t_ortholog_type_per_clade 
        WHERE 
            ortholog_sets.ortholog_id = t_ortholog_type_per_clade.ortholog_id AND 
            (
                (
                ortholog_sets.ortholog_type <> 'pseudo' AND 
                ortholog_sets.ortholog_type <> 'Orphan paralog'
                ) OR
            ortholog_sets.ortholog_type IS NULL
            ) AND
            protocol_id = $protocol_id;
	DROP INDEX i__t_ortholog_sets;
    VACUUM ANALYSE orthologs.ortholog_sets ;
PL/SQLCMD
	$dbh->do( $sql_cmd) or confess $dbh->errstr.".";
}

#	Update the ortholog_type in the table ortholog_sets for a specific protocol_id
#	$initial determines whether this should be restricted to previously identified 
#	orthologs
sub calculate_ortholog_type_in_ortholog_sets($$$)
{
	my ($dbh, $protocol_id, $initial) = @_;
	get_ortholog_counts_per_clade_per_species($dbh, $protocol_id, $initial);
	get_ortholog_counts_per_clade($dbh);
	set_ortholog_types_per_clade_by_counts($dbh);
	update_ortholog_types($dbh, $protocol_id);
}


1;




